Chip 1997 October/CD CHIP.ISO/WebServ/server7/FiltDemo.dpr

Text File | 1996-10-06 | 12.6 KB | 304 lines

(***************************************************************************



 Name:

   Delphi unit HttpFilt.dpr



 Notes:

   This module was built to demonstrate building an ISAPI filter with

   Delphi 2.0. This filter demonstrates all the basic functionality and

   data structures available to ISAPI filters. If compiled, it will create

   httpfilt.dll. You can add this filter to your registry, restart IIS and

   load a page from your IIS server. A log file will be written to

   c:\filtlog.svg showing each event and the filter will modify the data

   written to the HTTP user agent. This filter's purpose in life is to

   demonstrate ISAPI filters--it is very simple, but this should get you

   started with ISAPI filter writing. Best wishes,



   Stephen Genusa <[e-mail]> 06/08/96





 Abstract:



   This module contains the types, constants, and functions needed to

   create ISAPI Filter DLLs with Delphi 2.0.



   For more information on ISAPI, The Microsoft Internet Information FAQ is

   located at http://rampages.onramp.net/~steveg/iis.html



   EyeSAPI, the ISAPI extension debugger/log utility is located at

   http://rampages.onramp.net/~steveg/testisap.zip





 Changes, fixes, and modifications; in reverse chronological order:



  By    Date       Description

  ----- ---------- -----------------------------------------------------------
  MWT   7/6/95     Hacked up SVG's work to check filter operation

  SVG   06/08/96   Stephen Genusa <[e-mail]>

                   Fixed various structures. Tested most functionality

                   and provided example code to handle each data structure.



  JRT   05/05/96   Jonathan R. Taylor <[e-mail]>

                   Fixed forward reference problem with the

                   THTTP_FILTER_CONTEXT structure



  SVG   05/05/96   Translated From C to Delphi 2.0

                   by Stephen Genusa <[e-mail]>





****************************************************************************)





Library FiltDemo;



Uses

  SysUtils,

  Windows;



const



    HTTP_FILTER_MAJOR          = 1; { major version of this spec }

    HTTP_FILTER_MINOR          = 0; { minor version of this spec }

    SF_MAX_USERNAME            = 257;

    SF_MAX_PASSWORD            = 257;

    SF_MAX_FILTER_DESC_LEN     = 257;



{ SF_STATUS_TYPE }

    SF_STATUS_TYPE                     = $8000000;  { base value }

    SF_STATUS_REQ_FINISHED             = SF_STATUS_TYPE;

    SF_STATUS_REQ_FINISHED_KEEP_CONN   = SF_STATUS_TYPE + 1;

    SF_STATUS_REQ_NEXT_NOTIFICATION    = SF_STATUS_TYPE + 2;

    SF_STATUS_REQ_HANDLED_NOTIFICATION = SF_STATUS_TYPE + 3;

    SF_STATUS_REQ_ERROR                = SF_STATUS_TYPE + 4;

    SF_STATUS_REQ_READ_NEXT            = SF_STATUS_TYPE + 5;



    SF_NOTIFY_SECURE_PORT              = $00000001;

    SF_NOTIFY_NONSECURE_PORT           = $00000002;

    SF_NOTIFY_READ_RAW_DATA            = $00008000;

    SF_NOTIFY_PREPROC_HEADERS          = $00004000;

    SF_NOTIFY_AUTHENTICATION           = $00002000;

    SF_NOTIFY_URL_MAP                  = $00001000;

    SF_NOTIFY_SEND_RAW_DATA            = $00000400;

    SF_NOTIFY_LOG                      = $00000200;

    SF_NOTIFY_END_OF_NET_SESSION       = $00000100;



    SF_NOTIFY_ORDER_HIGH               = $00080000;

    SF_NOTIFY_ORDER_MEDIUM             = $00040000;

    SF_NOTIFY_ORDER_LOW                = $00020000;

    SF_NOTIFY_ORDER_DEFAULT            = SF_NOTIFY_ORDER_LOW;

    SF_NOTIFY_ORDER_MASK               = (SF_NOTIFY_ORDER_HIGH or SF_NOTIFY_ORDER_MEDIUM or SF_NOTIFY_ORDER_LOW);



type


    PVOID = Pointer;

    LPVOID = Pointer;

    PCardinal = ^Cardinal;



    SF_REQ_TYPE = (SF_REQ_SEND_RESPONSE_HEADER, SF_REQ_ADD_HEADERS_ON_DENIAL,

                   SF_REQ_SET_NEXT_READ_SIZE, SF_REQ_SET_PROXY_INFO);



    Type

      TFuncPlaceHolder = POINTER;



    THTTP_FILTER_CONTEXT = record

      cbSize             : DWORD;

      Revision           : DWORD;

      ServerContext      : PVOID;

      ulReserved         : DWORD;

      fIsSecurePort      : BOOL;

      pFilterContext     : PVOID;

      GetServerVariable  : TFuncPlaceHolder; {TGetServerVariable;}

      AddResponseHeaders : TFuncPlaceHolder; {TAddResponseHeaders;}

      WriteClient        : TFuncPlaceHolder; {TWriteClient;}

      AllocMen           : TFuncPlaceHolder; {TAllocMem;}

      ServerSupportFunc  : TFuncPlaceHolder; {TServerSupportFunc;}

    end;

    HTTP_FILTER_CONTEXT = THTTP_FILTER_CONTEXT;

    PHTTP_FILTER_CONTEXT = ^HTTP_FILTER_CONTEXT;





    TGetServerVariable  = Function(var pfc          : THTTP_FILTER_CONTEXT;

                                       VariableName : PChar;

                                       Buffer       : PChar;

                                       var BuffSize : DWORD) : BOOL;

                                       StdCall;



    TAddResponseHeaders = Function(var pfc          : THTTP_FILTER_CONTEXT;

                                       Headers      : PChar;

                                       Reserved     : DWORD) : BOOL;

                                       StdCall;



    TWriteClient        = Function(var pfc          : THTTP_FILTER_CONTEXT;

                                       Buffer       : LPVOID;

                                       dwBytes      : LPDWORD;

                                       Reserved     : DWORD) : BOOL;

                                       StdCall;



    TAllocMem           = Procedure(var pfc         : THTTP_FILTER_CONTEXT;

                                        cbSize      : DWORD;

                                        dwReserved  : DWORD);



    TServerSupportFunc = Function(var  pfc          : THTTP_FILTER_CONTEXT;

                                       sfReq        : SF_REQ_TYPE;

                                       pData        : PVOID;

                                       ul1          : DWORD;

                                       ul2          : DWORD) : BOOL;

                                       StdCall;







    THTTP_FILTER_RAW_DATA = record

      pvInData   : PVOID;

      cbInData   : DWORD;

      cbInBuffer : DWORD;

      dwReserved : DWORD;

    end;

    HTTP_FILTER_RAW_DATA  = THTTP_FILTER_RAW_DATA;

    PHTTP_FILTER_RAW_DATA = ^HTTP_FILTER_RAW_DATA;



    TGetHeader = Function(var pfc       : THTTP_FILTER_CONTEXT;

                              lpszName  : PChar;

                              lpvBuffer : LPVOID;

                              lpdwSize  : LPDWORD) : BOOL; StdCall;



    TSetHeader = Function(var pfc : THTTP_FILTER_CONTEXT;

                              lpszName  : PChar;

                              lpszValue : PChar) : BOOL; StdCall;



    TAddHeader = Function(var pfc : THTTP_FILTER_CONTEXT;

                              lpszName  : PChar;

                              lpszValue : PChar) : BOOL; StdCall;









    THTTP_FILTER_PREPROC_HEADERS = record

      GetHeader  : TGetHeader;

      SetHeader  : TSetHeader;

      AddHeader  : TAddHeader;

      dwReserved : DWORD;

    end;

    HTTP_FILTER_PREPROC_HEADERS  = THTTP_FILTER_PREPROC_HEADERS;

    PHTTP_FILTER_PREPROC_HEADERS = ^HTTP_FILTER_PREPROC_HEADERS;





    THTTP_FILTER_AUTHENT = record

      pszUser        : PChar;

      cbUserBuff     : DWORD;

      pszPassword    : PChar;

      cbPasswordBuff : DWORD;

    end;

    HTTP_FILTER_AUTHENT  = THTTP_FILTER_AUTHENT;

    PHTTP_FILTER_AUTHENT = ^HTTP_FILTER_AUTHENT;





    THTTP_FILTER_URL_MAP = record

      pszURL : PChar;

      pszPhysicalPath : PChar;

      cbPathBuff : DWORD;

    end;

    HTTP_FILTER_URL_MAP  = THTTP_FILTER_URL_MAP;

    PHTTP_FILTER_URL_MAP = ^HTTP_FILTER_URL_MAP;





    THTTP_FILTER_LOG = record

      pszClientHostName : PChar;

      pszClientUserName : PChar;

      pszServerName     : PChar;

      pszOperation      : PChar;

      pszTarget         : PChar;

      pszParameters     : PChar;

      dwHttpStatus      : DWORD;

      dwWin32Status     : DWORD;

    end;

    HTTP_FILTER_LOG  = THTTP_FILTER_LOG;

    PHTTP_FILTER_LOG = ^HTTP_FILTER_LOG;





    THTTP_FILTER_VERSION = record

      dwServerFilterVersion : DWORD;

      dwFilterVersion       : DWORD;

      lpszFilterDesc        : array [0..(SF_MAX_FILTER_DESC_LEN-1)] of Char;

      dwFlags               : DWORD;

    end;

    HTTP_FILTER_VERSION = THTTP_FILTER_VERSION;

    PHTTP_FILTER_VERSION = ^HTTP_FILTER_VERSION;

    TFilter=class
     public
      procedure AssignContext(var thisFC: HTTP_FILTER_CONTEXT);
      function  GetServerVar(varName: String): String;
     private
      pFC: PHTTP_FILTER_CONTEXT;
    end;



procedure TFilter.AssignContext(var thisFC: HTTP_FILTER_CONTEXT);
begin
  pFC:=@thisFC;
end;

function  TFilter.GetServerVar(varName: String): String;
var
  ss: ShortString;
  buf: array[0..255] of char absolute ss;
  len: Integer;
  FNGetServerVariable: TGetServerVariable;
begin
  len:=255;
  @FNGetServerVariable:=pFC^.GetServerVariable;
  if FNGetServerVariable(pFC^, PChar(varName), Pointer(@buf[1]), len ) then
  begin
    ss[0]:=Char(len);
    result:=ss;
  end
  else
    Result:='<UNKNOWN>';
end;

function ExpandToken(token, expandedString: String; var buffer: String; var bufferSize: Integer): Integer;
var
  i: Integer;
  newString: String;
  sizeDelta: Integer;
begin
   sizeDelta:=0;

   // Keep scanning through the buffer as long
   // as we keep finding occurances of the token
   repeat
     newString:='';

     i:=Pos('%'+token+'%', buffer);
     if i<>0 then
     begin
       // We found the token
       newString:=expandedString;
       buffer:=Copy(buffer, 1, i-1)+newString+Copy(buffer, i+Length(token)+2, bufferSize-i);

       // Adjust the buffer size
       bufferSize:=bufferSize+Length(expandedString)-Length(token)-2;
     end
   until newString='';
   result:=sizeDelta;
end;

procedure ProcessTokens(var buffer: String; var bufferSize: Integer; filter: TFilter);
begin
  ExpandToken('TIME',            DateTimeToStr(Now),                      buffer, bufferSize );
  ExpandToken('REMOTE_ADDR',     filter.GetServerVar('REMOTE_ADDR'),      buffer, bufferSize );
  ExpandToken('REMOTE_USER',     filter.GetServerVar('REMOTE_USER'),      buffer, bufferSize );
  ExpandToken('SERVER_NAME',     filter.GetServerVar('SERVER_NAME'),      buffer, bufferSize );
  ExpandToken('SERVER_SOFTWARE', filter.GetServerVar('SERVER_SOFTWARE'),  buffer, bufferSize );
end;

Function GetFilterVersion(var pVer : HTTP_FILTER_VERSION) : BOOL; export; stdcall;

begin
  pVer.dwFilterVersion := MAKELONG(0, 1);
  StrPCopy(pVer.lpszFilterDesc, 'Filter Demo version 0.94');
  pVer.dwFlags := (SF_NOTIFY_URL_MAP OR SF_NOTIFY_SEND_RAW_DATA);
  result := True;
end;



Function HttpFilterProc(var pfc : HTTP_FILTER_CONTEXT; NotificationType : DWORD; pvNotification : LPVOID) : DWORD; export; stdcall;
var
  filter: TFilter;

   function OnURLMap : DWORD;
   var
     mapStruct: HTTP_FILTER_URL_MAP;
   begin
     result := SF_STATUS_REQ_NEXT_NOTIFICATION;

     mapStruct:=HTTP_FILTER_URL_MAP(pvNotification^);
     //PChar(mapStruct.pszPhysicalPath)[mapStruct.cbPathBuff-1]:=#0;

     if (Pos('.HTM', String(mapStruct.pszPhysicalPath))<>0 ) OR (Pos('.htm', String(mapStruct.pszPhysicalPath))<>0 ) then
       pfc.pFilterContext:=PVOID(1)
     else
       pfc.pFilterContext:=PVOID(0);


   end;

   // OnSendRawData
   function OnSendRawData : DWORD;
   var
     rawStruct : PHTTP_FILTER_RAW_DATA;
     s : String;
   begin
     result := SF_STATUS_REQ_NEXT_NOTIFICATION;

     if pfc.pFilterContext=nil then
       Exit;

     // Cast the pointer. Note we keep it a pointer here
     // locally so that we can return any mods made to the
     // struct (such as length)
     rawStruct := PHTTP_FILTER_RAW_DATA(pvNotification);

     PChar(rawStruct.pvInData)[rawStruct.cbInBuffer-1]:=#0;

     SetLength(s, 16384);
     StrCopy(PChar(s), rawStruct.pvInData);

     // Process the tokens and also make the required
     // adjustments to size
     ProcessTokens(s, rawStruct.cbInData, filter);


     StrCopy(rawStruct.pvInData, PChar(s));
   end;





begin
  result:=SF_STATUS_REQ_NEXT_NOTIFICATION;
  //Exit;

  try
    filter:=TFilter.Create;

    filter.AssignContext(pfc);

    Case NotificationType of
      SF_NOTIFY_URL_MAP:
      begin
        result:=OnURLMap;
      end;
      SF_NOTIFY_SEND_RAW_DATA:
      begin
        result := OnSendRawData;
      end;
    end;
    filter.Free;
  except
    ;
  end;
end;





exports

  HttpFilterProc,

  GetFilterVersion;





end.